'''''''''''''''''''''''''''''''''''''''''''''''''''
' NOTE:
' You'll need to pay attention to where the code
' references controls on the, form and modify your
' control names accordingly.
'''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''
' Code for frmCreditHold
'
''''''''''''''''''''''''''
Option Compare Database
Option Explicit

Private Sub cmdAdd_Click()
' Adds a credit hold for the customer using the CustomerID
' entered in txtCustomerID. The code uses ADO to pass the input
' parameter values to the Credit.InsertCreditHold stored procedure.
' The output parameter values specified in the stored procedure are
' returned in returnCode and returnMessage. You can use returnCode
' to branch to other procedures if necessary.

Dim CustomerID As Integer
CustomerID = Me.cboCustomerID

Dim emailAddress As String
emailAddress = Me.cboCustomerID.Column(2)

Dim returnCode As Integer
Dim returnMessage As String
Dim CreditHoldID As Integer

    Dim strConnect As String
    '' Vista
    strConnect = "Driver={SQL Server};" & _
        "Server=(local);Database=AdventureWorksLT;Trusted_Connection=Yes"
    ''XP, Win2003
'    strConnect = "ODBC;Driver={SQL Native Client};" & _
'        "Server=(local);Database=AdventureWorksLT;Trusted_Connection=Yes"

    Dim cnn As ADODB.Connection
    Dim cmd As ADODB.Command
    
On Error GoTo Handle_Err
    Set cnn = New ADODB.Connection
    cnn.Open strConnect
    Set cmd = New ADODB.Command
    
   ' Set up the command and parameters
   With cmd
        Set .ActiveConnection = cnn
        .CommandText = "Credit.InsertCreditHold"
        .CommandType = adCmdStoredProc
        
        .Parameters.Append .CreateParameter( _
            "@CustomerID", adinteger, adParamInput, 8, CustomerID)
        .Parameters.Append .CreateParameter( _
            "@EmailAddress", adVarChar, adParamInput, 50, emailAddress)
        .Parameters.Append .CreateParameter( _
            "@CreditHoldID", adinteger, adParamOutput, 8)
        .Parameters.Append .CreateParameter( _
            "@RetCode", adinteger, adParamOutput, 8)
        .Parameters.Append .CreateParameter( _
            "@RetMsg", adVarChar, adParamOutput, 255)
    
        .Execute
        
        ' Get output parameters
        CreditHoldID = .Parameters("@CreditHoldID")
        returnCode = .Parameters("@RetCode")
        returnMessage = .Parameters("@RetMsg")
    End With
    
    MsgBox (CreditHoldID & " returned")
    Set cmd = Nothing
    
    ' Refresh the form
    Me.Requery

Exit_Here:
  ' Ensure that connection is closed and released.
  If Not cnn Is Nothing Then
      If cnn.State = adStateOpen Then
          cnn.Close
      End If
      Set cnn = Nothing
  End If
  Exit Sub
  
Handle_Err:
  Select Case Err.Number
    Case Else
        MsgBox Err.Number & ": " & Err.Description
  End Select
  Resume Exit_Here
  Resume
End Sub

Private Sub cmdRefresh_Click()
' Runs the append query that populates the local table
' with customer data. Error handling is demo-mode, I suggest
' you modify the error handler in cmdAdd_Click().

On Error Resume Next

Dim db As Database
Set db = CurrentDb

' Delete old data from tblCustomer
db.Execute ("Delete * From tblCustomerLocal")

' Execute the append query that selects
' from the passthrough query
db.Execute ("qryAppendCustomerLocal")

Me.Requery
If Err = 0 Then MsgBox ("Local table refreshed")

End Sub

Private Sub cmdRelease_Click()
' Releases a credit hold for the customer specified in the txtCustomerID.
' The code uses DAO to manipulate a QueryDef object's .SQL property to
' pass parameters and execute the Credit.RemoveCreditHold stored procedure
' using a passthrough query. The stored procedure returns a Recordset.

Dim strSQL As String
' This is the query string that will be passed to the .SQL
' property of the QueryDef object (pass-through query)
strSQL = "EXECUTE Credit.RemoveCreditHold " & Me.txtCreditHoldID

Dim strConnect As String
' Note that the connection string for DAO uses SQL Native Client.
strConnect = "ODBC;Driver={SQL Native Client};" & _
    "Server=(local);Database=AdventureWorksLT;Trusted_Connection=Yes"
    
' Put some decent error handling here
On Error Resume Next

Dim db As DAO.Database
Dim qdf As DAO.QueryDef

Set db = CurrentDb
Set qdf = db.QueryDefs("sptRemoveCreditHold")
qdf.Connect = strConnect
qdf.ReturnsRecords = True
qdf.SQL = strSQL

DoCmd.OpenQuery ("sptRemoveCreditHold")

Me.Requery

If Err = 0 Then MsgBox ("Credit hold released.")
End Sub

'''''''''''''''''''''''''''''''''
' Code for frmLinkTables
'''''''''''''''''''''''''''''''''
Option Compare Database
Option Explicit

Private Sub cmdLinkSalesOrders_Click()
' Create linked table to Sales.vSalesOrderWithDetails view
' in the AdventureWorks database. Normally you'd pass in
' the object names as arguments to the procedure.
Dim db As DAO.Database
Dim connectionString As String
Dim sourceTableName As String
Dim tableDefName As String
Dim i As Integer
    
Set db = CurrentDb
    
sourceTableName = "Sales.vSalesOrderWithDetails"
tableDefName = "SalesOrders"
    
' Ignore errors.
On Error Resume Next

' Delete existing linked table
i = DeleteTableDef(tableDefName)

connectionString = "ODBC;Driver={SQL Native Client};" & _
    "Server=(local);Database=AdventureWorks;Trusted_Connection=Yes"

' Create a new linked table
Dim tdf As DAO.TableDef
Set tdf = db.CreateTableDef(tableDefName)
tdf.Connect = connectionString
tdf.sourceTableName = sourceTableName

db.TableDefs.Append tdf
db.TableDefs.Refresh

'' Create unique index on the TableDef
'' When this line is commented out, sorting and filtering
'' will work more reliably. If you uncomment it, then Access
'' will allow you to modify data but filtering large result
'' sets will be unreliable.

' db.Execute "CREATE UNIQUE INDEX ixName on SalesOrders (SalesOrderID)"

Debug.Print (Err = 0)
End Sub

Private Sub cmdPlaceAsAdmin_Click()
Dim strConnection As String
Dim i As Integer

' Specify the driver, the server, and the connection
strConnection = "ODBC;Driver={SQL Native Client};" & _
    "Server=(local);Database=AdventureWorksLT;Trusted_Connection=Yes;"

' Delete and recreate the linked table.
i = DeleteTableDef("CreditHold")
i = CreateTableDef(strConnection, "Credit.CreditHold", "CreditHold")

If Err = 0 Then MsgBox ("CreditHold linked using trusted connection.")

End Sub

Private Sub cmdPlaceAsLRU_Click()

Dim strConnection As String
Dim i As Integer

' Specify a SQL Server login and password
strConnection = "ODBC;Driver={SQL Native Client};" & _
   "Server=(Local);Database=AdventureWorksLT;" & _
   "UID=LocalUser;PWD=pass@word1;"

' Delete and recreate the linked table.
i = DeleteTableDef("CreditHold")
i = CreateTableDef(strConnection, "Credit.CreditHold", "CreditHold")

If Err = 0 Then MsgBox ("CreditHold linked using least privilege.")
End Sub

Public Function CreateTableDef( _
    connectionString As String, _
    sourceTableName As String, _
    tableDefName As String) As Integer
    Dim db As DAO.Database
    Set db = CurrentDb
        
' Ignore errors
On Error Resume Next

    Dim tdf As DAO.TableDef
    Set tdf = db.CreateTableDef(tableDefName)
    
    ' Set the properties of the TableDef object
    tdf.Connect = connectionString
    tdf.sourceTableName = sourceTableName
    tdf.Connect = connectionString
    
    db.TableDefs.Append tdf
    db.TableDefs.Refresh

    CreateTableDef = (Err = 0)
End Function


Public Function DeleteTableDef(tableDefName) As Integer
' Deletes the specified TableDef

Dim db As DAO.Database
Set db = CurrentDb
        
' Ignore errors
On Error Resume Next
    Dim tdf As DAO.TableDef
    Set tdf = db.TableDefs(tableDefName)
    db.TableDefs.Delete tableDefName
    
    Set tdf = Nothing
    db.TableDefs.Refresh
    
    DeleteTableDef = (Err = 0)
End Function

Public Function RefreshTableDefs(connectionString As String) As Integer
    Dim db As DAO.Database
    Set db = CurrentDb
    Dim tdf As DAO.TableDef
    db.TableDefs.Refresh
    
On Error Resume Next
    For Each tdf In CurrentDb.TableDefs
        With tdf
        ' Only process linked ODBC tables
            If .Attributes = dbAttachedODBC Then
                .Connect = connectionString
           End If
       End With
    Next tdf
 
    RefreshTableDefs = (Err = 0)
End Function

Private Sub Form_Load()

' Remove any linked TableDef objects.
' For the demo only CreditHold is being deleted.
' Uncomment the block at the bottom of the procedure
' to do delete all of them.

Dim db As DAO.Database
Set db = CurrentDb
Dim tdf As DAO.TableDef
    
On Error Resume Next
    db.TableDefs.Delete ("CreditHold")

'' This code block loops through and deletes the linked tables
'    For Each tdf In CurrentDb.TableDefs
'        With tdf
'         Only process linked ODBC tables
'            If .Attributes = dbAttachedODBC Then
'                db.TableDefs.Delete (tdf.Name)
'           End If
'       End With
'    Next tdf
'    db.TableDefs.Refresh
Debug.Print Err.Number & ": " & Err.Description
End Sub




